Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH6/SRC/BDITCH2.FRM

Text File | 1996-04-24 | 8KB | 281 lines

VERSION 4.00
Begin VB.Form BDitch2Form
   Caption         =   "Bowditch 2"
   ClientHeight    =   5670
   ClientLeft      =   2070
   ClientTop       =   930
   ClientWidth     =   4830
   Height          =   6360
   Left            =   2010
   LinkTopic       =   "Form1"
   ScaleHeight     =   378
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   322
   Top             =   300
   Width           =   4950
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4815
      Left            =   0
      ScaleHeight     =   -2.2
      ScaleLeft       =   -1.1
      ScaleMode       =   0  'User
      ScaleTop        =   1.1
      ScaleWidth      =   2.2
      TabIndex        =   13
      Top             =   840
      Width           =   4815
   End
   Begin VB.TextBox QText
      Height          =   285
      Left            =   3120
      TabIndex        =   10
      Text            =   "5"
      Top             =   45
      Width           =   615
   End
   Begin VB.TextBox PText
      Height          =   285
      Left            =   2040
      TabIndex        =   9
      Text            =   "4"
      Top             =   45
      Width           =   615
   End
   Begin VB.TextBox ThetaText
      Height          =   285
      Left            =   4200
      TabIndex        =   7
      Text            =   "30"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox YscaleText
      Height          =   285
      Left            =   2040
      TabIndex        =   5
      Text            =   "0.6"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox XscaleText
      Height          =   285
      Left            =   600
      TabIndex        =   3
      Text            =   "0.9"
      Top             =   480
      Width           =   615
   End
   Begin VB.TextBox DtText
      Height          =   285
      Left            =   240
      TabIndex        =   2
      Text            =   "0.01"
      Top             =   45
      Width           =   615
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   375
      Left            =   4200
      TabIndex        =   0
      Top             =   0
      Width           =   615
   End
   Begin VB.Label Label1
      Caption         =   "Q"
      Height          =   255
      Index           =   6
      Left            =   2955
      TabIndex        =   12
      Top             =   60
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "P"
      Height          =   255
      Index           =   4
      Left            =   1920
      TabIndex        =   11
      Top             =   60
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "Angle (degrees)"
      Height          =   255
      Index           =   5
      Left            =   3000
      TabIndex        =   8
      Top             =   525
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Y scale"
      Height          =   255
      Index           =   3
      Left            =   1440
      TabIndex        =   6
      Top             =   525
      Width           =   615
   End
   Begin VB.Label Label1
      Caption         =   "X scale"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   4
      Top             =   525
      Width           =   615
   End
   Begin VB.Label Label1
      Caption         =   "dt"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   1
      Top             =   60
      Width           =   255
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "BDitch2Form"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Const PI = 3.14159
Const TWO_PI = 2 * PI

Dim P As Integer
Dim Q As Integer

' ************************************************
' Draw the curve on the indicated picture box.
' ************************************************
Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, Dt As Single, xscale As Single, yscale As Single, theta As Single)
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
Dim ctheta As Single
Dim stheta As Single
Dim t As Single

    ' Save these values because we use them a lot.
    stheta = Sin(theta)
    ctheta = Cos(theta)

    x1 = xscale * X(start_t)
    y1 = yscale * Y(start_t)
    x2 = x1 * ctheta - y1 * stheta
    y2 = x1 * stheta + y1 * ctheta
    pic.Cls
    pic.CurrentX = x2
    pic.CurrentY = y2

    t = start_t + Dt
    Do While t < stop_t
        x1 = xscale * X(t)
        y1 = yscale * Y(t)
        x2 = x1 * ctheta - y1 * stheta
        y2 = x1 * stheta + y1 * ctheta
        pic.Line -(x2, y2)
        t = t + Dt
    Loop

    x1 = xscale * X(stop_t)
    y1 = yscale * Y(stop_t)
    x2 = x1 * ctheta - y1 * stheta
    y2 = x1 * stheta + y1 * ctheta
    pic.Line -(x2, y2)
End Sub

' ************************************************
' Non-recursively compute the greatest common
' divisor of to integers.
' ************************************************
Private Function GCD(ByVal a As Integer, ByVal b As Integer) As Integer
Dim B_Mod_A As Integer

    B_Mod_A = b Mod a
    Do While B_Mod_A <> 0
        ' Prepare the arguments for the "recursion."
        b = a
        a = B_Mod_A
        B_Mod_A = b Mod a
    Loop

    GCD = a
End Function


' ************************************************
' Find the least common multiple of two integers.
' ************************************************
Function LCM(a As Integer, b As Integer) As Integer
    LCM = a * b / GCD(a, b)
End Function


' ************************************************
' Calculate the values t must cross to draw a
' Bowditch Curve.
' ************************************************
Sub SetTBounds(tmin As Single, tmax As Single)
    tmin = 0
    tmax = LCM(P, Q) / P / Q * TWO_PI
    If P Mod 2 = 1 And Q Mod 2 = 1 Then
        tmin = -tmax / 4
        tmax = tmax / 4
    End If
End Sub



' ************************************************
' The parametric function X(t).
' ************************************************
Function X(t As Single) As Single
    X = Sin(P * t)
End Function
' ************************************************
' The parametric function Y(t).
' ************************************************
Function Y(t As Single) As Single
    Y = Sin(Q * t)
End Function

Private Sub CmdGo_Click()
Dim tmin As Single
Dim tmax As Single
Dim Dt As Single
Dim xscale As Single
Dim yscale As Single
Dim theta As Single

    P = CInt(PText.Text)
    Q = CInt(QText.Text)

    SetTBounds tmin, tmax

    Dt = CSng(DtText.Text)
    xscale = CSng(XscaleText.Text)
    yscale = CSng(YscaleText.Text)
    theta = CSng(ThetaText.Text) / 180 * PI

    DrawCurve Canvas, tmin, tmax, Dt, xscale, yscale, theta
End Sub


Private Sub mnuFileExit_Click()
    Unload Me
End Sub